unit Skin;

interface

uses
  Types, Graphics;

type
  TFontRec = record
    name: WideString;
    size: Integer;
    style: TFontStyles;
    pitch: TFontPitch;
    color: TColor;
    charset: TFontCharSet;
  end;
  TFontRecArray = array of TFontRec;

  TSkin = class
  private
    fBGColor: TColor;
    fSelectedColor: TColor;
    fTotalItemHeight: Integer;
    fItemHeights: TIntegerDynArray;
    fItemHeightsCount: Integer;
    fFonts: TFontRecArray;
    fFontsCount: Integer;
  public
    property BGColor: TColor read fBGColor write fBGColor;
    property SelectedColor: TColor read fSelectedColor write fSelectedColor;
    property TotalItemHeight: Integer read fTotalItemHeight;
    property ItemHeights: TIntegerDynArray read fItemHeights;
    property ItemHeightsCount: Integer read fItemHeightsCount;
    property Fonts: TFontRecArray read fFonts;
    property FontsCount: Integer read fFontsCount;

    constructor Create(BGColor, SelectedColor: Integer;
                       ItemHeightsCount, FontsCount: Integer);
    procedure AddItemHeight (Height: Integer);
    procedure AddFont (_name: WideString; _size: Integer; _style: WideString;
                       _pitch: WideString; _color: Integer; _charset: Integer);
    procedure Commit;

    procedure AssignFont (const Font: TFont; FontIndex: Integer);
  end;

implementation

uses
  Errors;

constructor TSkin.Create(BGColor, SelectedColor: Integer;
                         ItemHeightsCount, FontsCount: Integer);
  begin
    fBGColor := TColor(BGColor);
    fSelectedColor := TColor(SelectedColor);
    fTotalItemHeight := 0;
    SetLength(fItemHeights, ItemHeightsCount + 1);
    fItemHeights[0] := 0;
    fItemHeightsCount := 0;
    SetLength(fFonts, FontsCount);
    fFontsCount := 0;
  end;

procedure TSkin.AddItemHeight (Height: Integer);
  begin
    fTotalItemHeight := fTotalItemHeight + Height;
    Inc(fItemHeightsCount);
    fItemHeights[fItemHeightsCount] := fTotalItemHeight;
  end;

procedure TSkin.AddFont (_name: WideString; _size: Integer; _style: WideString;
                         _pitch: WideString; _color: Integer; _charset: Integer);
  function getStyle: TFontStyles;
    procedure AddStyle (S: WideString);
      begin
        if S = 'bold' then
          Include(Result, fsBold)
        else if S = 'italic' then
          Include(Result, fsItalic)
        else if S = 'underline' then
          Include(Result, fsUnderline)
        else if S = 'strike' then
          Include(Result, fsStrikeOut)
        else begin
          Msg.Alert('unknown font style: ' + S);
        end;
      end;
    var I,K: Integer;
    begin
      Result := [];
      K := 0;
      for I := 0 to Length(_style) - 1 do begin
        if _style[I] = ' ' then begin
          if K < I then
            AddStyle(Copy(_style, K, I-K));
          K := I + 1;
        end;
      end;
      if K < Length(_style) then
        AddStyle(Copy(_style, K, Length(_style) - K));
    end;
  function getPitch: TFontPitch;
    begin
      if _pitch = 'default' then
        Result := fpDefault
      else if _pitch = 'fixed' then
        Result := fpFixed
      else if _pitch = 'variable' then
        Result := fpVariable
      else begin
        Msg.Alert('unknown font pitch: ' + _pitch);
        Result := fpDefault;
      end;
    end;
  begin
    with fFonts[fFontsCount] do begin
      name := _name;
      size := _size;
      style := getStyle;
      pitch := getPitch;
      color := TColor(_color);
      charset := TFontCharSet(_charset);
    end;
    Inc(fFontsCount);
  end;

procedure TSkin.Commit;
  begin
    // do nothing
  end;

procedure TSkin.AssignFont (const Font: TFont; FontIndex: Integer);
  var F: TFontRec;
  begin
    F := fFonts[FontIndex];
    with Font do begin
      Name := F.name;
      Size := F.size;
      Style := F.style;
      Pitch := F.pitch;
      Color := F.color;
      Charset := F.charset;
    end;
  end;

end.
